ezVERSION = 3.00vcrcomboboxPixelsClassdFontName = "MS Sans Serif" FontSize = 8 Height = 23 Width = 106 Name = "distinct_values_combo" PROCEDURE Destroy cCursor = "c" + THIS.name IF USED(cCursor) THEN USE IN &cCursor ENDIF ENDPROC PROCEDURE Init #DEFINE NO_TABLE_LOC "The table alias must be specified in the controlSource property, in the format 'alias.column'." IF !EMPTY(THIS.controlSource) THEN IF NOT "." $ THIS.controlSource THEN =MESSAGEBOX(NO_TABLE_LOC) ELSE cAlias = LEFTC(THIS.controlSource,(ATC(".",THIS.controlSource)-1)) cColumn = RIGHTC(THIS.controlSource,(LENC(THIS.controlSource)-ATC(".",THIS.controlSource))) THIS.rowSourceType = 3 cSQL = "SELECT DISTINCT " + cColumn + " FROM " + cAlias + ; " INTO CURSOR c" + THIS.name THIS.rowSource = cSQL ENDIF ENDIF ENDPROC  nG%!N0U%C &FC%C,Are you sure you want to delete this record?$x %C+  H%C+C  H UTHISPARENTCNAVIGATION_TABLETHISFORMREFRESHClick,1fA1AA1AA1) '%U<%C &F UTHISPARENTCNAVIGATION_TABLETHISFORMREFRESHClick,1aAR1)1distinct_values_combocombobox1ClassPixelsdistinct_values_combo)MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 7vcrcomboboxcontrolFontName = "MS Sans Serif" FontSize = 8 Height = 23 Width = 106 display_column = lookup_table = return_column = order_column = Name = "lookup_combo" PROCEDURE Init #DEFINE NO_LOOKUP_TABLE_LOC "A lookup table must be specified in the 'lookup_table' property (combo box " + THIS.name + ")." #DEFINE NO_DISPLAY_COLUMN_LOC "A display column must be specified in the 'display_column' property (combo box " + THIS.name + ")." #DEFINE NO_RETURN_COLUMN_LOC "A return column must be specified in the 'return_column' property (combo box " + THIS.name + ")." lOK = .T. DO CASE CASE EMPTY(THIS.lookup_table) =MESSAGEBOX(NO_LOOKUP_TABLE_LOC,48) lOK = .F. CASE EMPTY(THIS.display_column) =MESSAGEBOX(NO_DISPLAY_COLUMN_LOC,48) lOK = .F. CASE EMPTY(THIS.return_column) =MESSAGEBOX(NO_RETURN_COLUMN_LOC,48) lOK = .F. ENDCASE IF lOK THEN IF !EMPTY(THIS.order_column) nSQL = "SELECT " + THIS.display_column + "," + THIS.return_column + " FROM " + THIS.lookup_table + " ORDER BY " + THIS.order_column + " INTO CURSOR " + THIS.name ELSE nSQL = "SELECT " + THIS.display_column + "," + THIS.return_column + " FROM " + THIS.lookup_table + " INTO CURSOR " + THIS.name ENDIF THIS.RowSourceType = 3 THIS.RowSource = nSQL THIS.BoundColumn = 2 ENDIF THIS.Refresh ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine #DEFINE INVALID_COLUMN_LOC "An invalid display column or return column has been specified in the 'display_column' or 'return_column' properties (combo box " + THIS.name + ")." #DEFINE INVALID_TABLE_LOC "An invalid table has been specified in the 'display_column' or 'lookup_table' property (combo box " + THIS.name + ")." #DEFINE INVALID_SORT_LOC "An invalid column has been specified in the 'order_column' property (combo box " + THIS.name + ")." DO CASE CASE nError = 1806 =MESSAGEBOX(INVALID_COLUMN_LOC,48) CASE nError = 1808 =MESSAGEBOX(INVALID_SORT_LOC,48) CASE nError = 1802 =MESSAGEBOX(INVALID_TABLE_LOC,48) OTHERWISE =MESSAGEBOX(MESSAGE(),48) ENDCASE ENDPROC PROCEDURE Destroy cAlias = THIS.name IF USED(cAlias) THEN USE IN &cAlias ENDIF ENDPROC 4 #% UM%C &F %C+ <#6 UTHISPARENTCNAVIGATION_TABLETHISFORMREFRESHClick,1aAQA1)H //% U]%C &F %C+;#)L H UTHISPARENTCNAVIGATION_TABLETHISFORMREFRESHClick,1aAQA1=)/I 005% U^%C &F %C;#6M H UTHISPARENTCNAVIGATION_TABLETHISFORMREFRESHClick,1aAQA1J)04 #% UM%C &F %C+ <#) UTHISPARENTCNAVIGATION_TABLETHISFORMREFRESHClick,1aAQA1)controlvWidth = 293 Height = 25 Picture = ..\..\books\ BackStyle = 0 BorderWidth = 0 cnavigation_table = Name = "vcr" Zcnavigation_table Specifies the table to navigate in. If blank, uses the current table.  commandbuttoncustom/Height = 15 Width = 23 Name = "datachecker"  datacheckercustomClassmanages conflicts1..\..\..\..\..\..\vfp\samples\classes\checker.bmpPixelsvcrjdisplay_column Specifies the column from lookup_table to display in the drop down list. lookup_table Specifies the table to lookup the values to display in the drop down. return_column Specifies the column value to return the value property of the combo box. order_column Specifies the column to order the records displayed in the drop down list (optional).  lookup_combocombobox1ClassPixels lookup_combo)MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 )MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 1..\..\..\..\..\..\vfp\samples\classes\checker.bmp datachecker commandbuttoncmdTopAutoSize = .F. Top = 1 Left = 1 Height = 23 Width = 39 FontName = "MS Sans Serif" FontSize = 8 Picture = ..\..\..\..\..\..\testing\ DisabledPicture = ..\..\..\..\..\..\testing\ Caption = "\-------- CASE m.lnScope = 0 IF m.luOldVal != m.luCurVal m.llMadeChange = .T. m.lnChoice = MESSAGEBOX(VALCHG1_LOC + CR_LOC + FIELD_LOC + lcField + CR_LOC + ; RECORD_LOC + ALLTRIM(STR(RECNO())) + ; IIF(TYPE("m.lcField") != "M", CR_LOC + CR_LOC + ORG_LOC + THIS.String(m.luOldVal) + ; CR_LOC + CUR_LOC + THIS.String(m.luCurVal) + ; CR_LOC + CHG_LOC + THIS.String(EVAL(m.lcField)), CR_LOC + CR_LOC + m.lcField + MEMO_LOC) + ; CR_LOC + CR_LOC + SAVE_LOC, + 3+48+0, CONFLICT_LOC) ENDIF * -----< check for conflicts and verify all changes >-------- CASE m.lnScope = 1 && Verify all changes m.luField = EVAL(m.lcField) IF m.luOldVal != m.luField OR m.luCurVal != m.luField m.llMadeChange = .T. m.lnChoice = MESSAGEBOX(VALCHG2_LOC + CR_LOC + FIELD_LOC + m.lcField + CR_LOC + ; RECORD_LOC + ALLTRIM(STR(RECNO())) + ; IIF(TYPE("m.lcField") != "M", CR_LOC + CR_LOC + ORG_LOC + THIS.String(m.luOldVal) + ; CR_LOC + CUR_LOC + THIS.String(m.luCurVal) + ; CR_LOC + CHG_LOC + THIS.String(EVAL(m.lcField)), CR_LOC + CR_LOC + m.lcField + MEMO_LOC) + ; CR_LOC + CR_LOC + SAVE_LOC, + 3+48+0, VERIFY_LOC) ENDIF ENDCASE DO CASE CASE m.lnChoice = 7 && No, don't save changes REPLACE (m.lcField) WITH m.luCurVal CASE m.lnChoice = 2 && Cancel, restore original value REPLACE (m.lcField) WITH m.luOldVal ENDCASE ENDFOR IF m.llMadeChange m.llSuccess = TABLEUPDATE(.F., .T.) RETURN IIF(m.llSuccess, 1, 2) ELSE RETURN 0 ENDIF ENDPROC PROCEDURE string *---------------------------------------------------------------* * This method is called from the HandleRecord method. It * returns the character equivalent of the value passed in as a * parameter. If a memo field is passed in, a notice to this * effect is returned rather than the value in the memo field so * that potentially large amounts of text aren't displayed in the * messagebox. *---------------------------------------------------------------* LPARAMETERS luValue m.uType = TYPE('m.luValue') DO CASE CASE m.uType = 'C' RETURN ALLTRIM(m.luValue) CASE INLIST(m.uType, 'N', 'Y') RETURN ALLTRIM(STR(m.luValue)) CASE m.uType = 'D' RETURN DTOC(m.luValue) CASE m.uType = 'T' RETURN TTOC('m.luValue') CASE m.uType = 'L' RETURN IIF(m.luValue, '.T.', '.F.') CASE uType = 'M' RETURN 'Memo field' ENDCASE ENDPROC PROCEDURE verifychanges *---------------------------------------------------------------* * If any changes have been made to the table or record, prompt the * user to save the changes. If the user says 'yes,' all changes * are saved. Any changes made to the data by other users after * this user made the change and before the change was committed * will be lost. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made All User Changes * 2 -- Unable to Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* * Declare constants & variables #define SAVECHG_LOC 'Do you want to save your changes?' #define SAVECHG2_LOC 'Save Changes' #define NOBUFF_LOC2 'Data buffering is not enabled.' LOCAL lnChoice, llMadeChange, lnSuccess m.llMadeChange = .F. m.lnSuccess = 0 * If the user has changed anything, prompt to save or discard changes DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) m.llMadeChange = .T. ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering IF GETNEXTMODIFIED(0) > 0 m.llMadeChange = .T. ENDIF OTHERWISE WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE IF m.llMadeChange m.lnChoice = MESSAGEBOX(SAVECHG_LOC, 4+32, SAVECHG2_LOC) IF m.lnChoice = 6 && Yes m.lnSuccess = IIF(TABLEUPDATE(.T.,.T.), 1, 2) ELSE =TABLEREVERT(.T.) ENDIF ENDIF RETURN m.lnSuccess ENDPROC PROCEDURE verifyeachchange *-------------------------------------------------------------------- * If any changes have been made to the table or record, for each * change, display the old value and the new value, prompting the * user to save or discard the change. Conflict management is also * included in the HandleRecord method. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made User-Specified Changes * 2 -- Unable to Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* #define NOBUFF_LOC3 'Data buffering is not enabled.' LOCAL lnSuccess, lnRec m.lnSuccess = 0 DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) && Data has changed m.lnSuccess = THIS.HandleRecord(1) ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering m.lnRec = GETNEXTMODIFIED(0) DO WHILE m.lnRec > 0 GO m.lnRec m.lnSuccess = IIF(m.lnSuccess != 2, THIS.HandleRecord(1), 2) m.lnRec = GETNEXTMODIFIED(m.lnRec) ENDDO OTHERWISE && No Buffering WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE RETURN m.lnSuccess ENDPROC PROCEDURE checkconflicts *---------------------------------------------------------------* * Checks to see whether another user has changed the value * stored in a table. If so, calls HandleRecord to display * the new value and allow the user to decide what to do. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made User-Specified Changes * 2 -- Unable to Make Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* #define NOBUFF1_LOC 'Data buffering is not enabled.' LOCAL lnSuccess, llnRec m.lnSuccess = 0 DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) && Data has changed m.lnSuccess = THIS.HandleRecord(0) ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering m.llnRec = GETNEXTMODIFIED(0) DO WHILE m.llnRec > 0 GO m.llnRec m.lnSuccess = IIF(m.lnSuccess != 2, THIS.HandleRecord(0), 2) m.llnRec = GETNEXTMODIFIED(m.llnRec) ENDDO OTHERWISE && no buffering WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE RETURN m.lnSuccess ENDPROC  %  UO%C m.lnScopebN3T %C  >R,4Invalid value passed to conflictmanager.handlerecord# T - T a%C SourceType C (C.T T C /%C bGM.T C _T C  H %   T aT C)A value has been changed by another user.C Field: C Record Number: CCCOZCC m.lcFieldbM}C C Original Value: C  C Current Value: C  C  Your change: CC  &C C   is a Memo field.6C C <Do you want to overwrite the current value with your change?C 0(Choose 'Cancel' to restore the original value.)3 Data Conflictx T C $%      T aT CA value has been changed.C Field:  C Record Number: CCCOZCC m.lcFieldbM}C C Original Value: C  C Current Value: C  C  Your change: CC  &C C   is a Memo field.6C C <Do you want to overwrite the current value with your change?C 0(Choose 'Cancel' to restore the original value.)3Verify Changesx H >   >  % 7T C-aBC 6H BU LNSCOPELNCHOICELNFIELDLCFIELDLUOLDVALLUCURVALLUFIELD LLMADECHANGE LLSUCCESSTHISSTRING T C m.luValueb H. CO BC  C NYwBCC Z D BC * TBC m.luValue LBC .T..F.6 MB Memo fieldULUVALUEUTYPE T -T  H8! CC Buffering%2C| T a! CC Buffering%C T a2 R,:% yET C!Do you want to save your changes?$ Save Changesx% cT CCaa6u Ca B ULNCHOICE LLMADECHANGE LNSUCCESS NOBUFF_LOC1 T  H'! CC Bufferingx%2CtT C! CC Buffering T C+  # *T C  C6T C 2 R,: B U LNSUCCESSLNRECTHIS HANDLERECORD NOBUFF_LOC1 T  H'! CC Bufferingx%2CtT C! CC Buffering T C+  # *T C  C6T C 2 R,: B U LNSUCCESSLLNRECTHIS HANDLERECORD NOBUFF_LOC handlerecord,string verifychangesverifyeachchange checkconflictsA 1AA1A2aAAAA2QVA21AAA1A1AAAA3zAAAQA!1A2 aAAAAQ1AA2aaA!AAAA2aaA!AAAA12WiC{K]r%pJ!) (%/rNU>Tc%C7USE IN &cCursor UCCURSORTHISNAME\%C U%. jC^The table alias must be specified in the controlSource property, in the format 'alias.column'.xQ$TCC.*TCCC.THTSELECT DISTINCT  FROM  INTO CURSOR cTUTHIS CONTROLSOURCECALIASCCOLUMN ROWSOURCETYPECSQLNAME ROWSOURCEDestroy,Init1Q1A23aAAA2\w)